home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / WASTE 1.1a4 / Demo Source / Segments.p < prev    next >
Encoding:
Text File  |  1994-10-15  |  3.6 KB  |  117 lines  |  [TEXT/PJMM]
  1. unit Segments;
  2.  
  3. { Routines for unloading code segments easily }
  4. { Copyright © 1994 Merzwaren }
  5.  
  6. { *** RATIONALE: *** }
  7. { Many applications are segmented so that some code segments are persistent }
  8. { (automatically preloaded and locked when the application is launched, }
  9. { never unloaded) and the others are non-persistent (loaded on demand, }
  10. { usually unloadable from the main event loop). }
  11. { Unfortunately, you must explicitly call _UnloadSeg to have a segment unloaded }
  12. { (i.e., unlocked and made purgeable) and you have to pass _UnloadSeg a pointer }
  13. { to [the jump table entry for] a routine in the segment to unload. }
  14. { This may not be always handy.  But wait!  The UnloadNonPersistentSegments }
  15. { routine automatically finds and unloads all non-persistent segments. }
  16. { It does this by listing all CODE resources whose locked attribute is clear }
  17. { (the resource attribute, _not_ the handle state) and whose purgeable attribute }
  18. { is set.  It then calculates the address of the jump table entry for the first routine }
  19. { in the segment and calls _UnloadSeg on the address. }
  20.  
  21. { *** THIS CODE ASSUMES THAT: *** }
  22. { The application has a traditional, IM II-style jump table (not a far-code JT) }
  23. { The current resource file is the application file }
  24. { The A5 register is set up correctly }
  25. { UnloadNonPersistentSegments is called from a persistent segment }
  26.  
  27. interface
  28.  
  29.     procedure UnloadNonPersistentSegments;
  30.  
  31. implementation
  32.  
  33.     const
  34.  
  35.         kTypeCodeSegment = 'CODE';        { application code segment resource type }
  36.  
  37.     type
  38.  
  39.         CodeSegment = record
  40.                 firstEntryOffset: Integer;        { offset of the first routine's entry from the beginning of the Jump Table }
  41.                 nEntries: Integer;                    { number of entries for this segment }
  42. { actual code follows... }
  43.             end;
  44.         CodeSegmentPtr = ^CodeSegment;
  45.         CodeSegmentHandle = ^CodeSegmentPtr;
  46.  
  47.     function GetResLoad: Boolean;
  48.     inline
  49.         $1EB8, $0A5E;        { move.b ResLoad, (sp) }
  50.  
  51.     function GetCurJTOffset: Integer;
  52.     inline
  53.         $3EB8, $0934;        { move.w CurJTOffset, (sp) }
  54.  
  55.     function GetA5: LongInt;
  56.     inline
  57.         $2E8D;                    { movea.l a5, (sp) }
  58.  
  59.     function GetSegmentByIndex (segmentIndex: Integer): Handle;
  60.         var
  61.             saveResLoad: Boolean;
  62.     begin
  63.  
  64. { temporarily disable loading of resources }
  65.         saveResLoad := GetResLoad;
  66.         SetResLoad(false);
  67.  
  68. { get a (possibly empty) handle to the specified segment }
  69.         GetSegmentByIndex := Get1IndResource(kTypeCodeSegment, segmentIndex);
  70.  
  71. { restore the original ResLoad flag }
  72.         SetResLoad(saveResLoad);
  73.  
  74.     end;  { GetSegmentByIndex }
  75.  
  76.     procedure UnloadSegmentHandle (hSegment: Handle);
  77.     begin
  78.  
  79. { do nothing if the segment handle is null or empty }
  80.         if (hSegment <> nil) then
  81.             if (hSegment^ <> nil) then
  82.  
  83. { calculate the address of the first routine entry in the segment }
  84. { and call _UnloadSeg on the calculated address }
  85.                 UnloadSeg(ProcPtr(GetA5 + GetCurJTOffset + CodeSegmentHandle(hSegment)^^.firstEntryOffset + 2));
  86.  
  87.     end;  { UnloadSegmentHandle }
  88.  
  89.     procedure UnloadNonPersistentSegments;
  90.         var
  91.             segmentIndex: Integer;
  92.             segmentAttributes: Integer;
  93.             hSegment: Handle;
  94.     begin
  95.  
  96. { loop through all code segments }
  97.         for segmentIndex := Count1Resources(kTypeCodeSegment) downto 1 do
  98.             begin
  99.  
  100. { get segment handle }
  101.                 hSegment := GetSegmentByIndex(segmentIndex);
  102.  
  103. { get resource attributes of the segment }
  104.                 segmentAttributes := GetResAttrs(hSegment);
  105.  
  106. { do nothing if a resource error occurred }
  107.                 if (ResError <> noErr) then
  108.                     Cycle;
  109.  
  110. { check whether 'purgeable' is on and 'locked' is off }
  111.                 if (BitAnd(segmentAttributes, resPurgeable + resLocked) = resPurgeable) then
  112.                     UnloadSegmentHandle(hSegment);
  113.  
  114.             end;  { for }
  115.     end;  { UnloadNonPersistentSegments }
  116.  
  117. end.